home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Plus 2004 #11
/
Amiga Plus CD - 2004 - No. 11.iso
/
AmiSoft
/
Dev
/
gg
/
perl-mos-diffs.lha
/
perl-5.6.1-diffs
Wrap
Text File
|
2004-09-01
|
46KB
|
1,396 lines
diff -ruN perl-5.6.1-orig/Configure perl-5.6.1/Configure
--- perl-5.6.1-orig/Configure Mon Mar 19 03:03:33 2001
+++ perl-5.6.1/Configure Sun Aug 29 16:25:58 2004
@@ -7150,7 +7150,7 @@
case "$myhostname" in
'') cont=true
echo 'Maybe "hostname" will work...'
- if tans=`sh -c hostname 2>&1` ; then
+ if tans=`/bin/sh -c hostname 2>&1` ; then
myhostname=$tans
phostname=hostname
cont=''
@@ -7173,17 +7173,17 @@
fi
if $test "$cont"; then
echo 'No, maybe "uuname -l" will work...'
- if tans=`sh -c 'uuname -l' 2>&1` ; then
+ if tans=`/bin/sh -c 'uuname -l' 2>&1` ; then
myhostname=$tans
phostname='uuname -l'
else
echo 'Strange. Maybe "uname -n" will work...'
- if tans=`sh -c 'uname -n' 2>&1` ; then
+ if tans=`/bin/sh -c 'uname -n' 2>&1` ; then
myhostname=$tans
phostname='uname -n'
else
echo 'Oh well, maybe I can mine it out of whoami.h...'
- if tans=`sh -c $contains' sysname $usrinc/whoami.h' 2>&1` ; then
+ if tans=`/bin/sh -c $contains' sysname $usrinc/whoami.h' 2>&1` ; then
myhostname=`echo "$tans" | $sed 's/^.*"\(.*\)"/\1/'`
phostname="sed -n -e '"'/sysname/s/^.*\"\\(.*\\)\"/\1/{'"' -e p -e q -e '}' <$usrinc/whoami.h"
else
diff -ruN perl-5.6.1-orig/README.morphos perl-5.6.1/README.morphos
--- perl-5.6.1-orig/README.morphos Thu Jan 1 00:00:00 1970
+++ perl-5.6.1/README.morphos Wed Sep 1 22:30:57 2004
@@ -0,0 +1,95 @@
+1. Introduction
+---------------
+This file describes particular issues on MorphOS port of Perl v5.6.1
+
+2. Requirements
+---------------
+No additional libraries and tools are needed to built Perl for MorphOS.
+
+3. Installation
+---------------
+Installation of the archive is simple. Just extract it into your GeekGadgets
+tree.
+
+4. Usage
+--------
+Usage of Perl under MorphOS does not differ from any other system. Just note
+that Perl is hungry for stack. On my system i use 327680 bytes long stack,
+this seems to be enough. With 163840 bytes Perl produced hits during some
+tests.
+
+It is recommended to read also "README.amiga" file. There you can find some
+topics which are not covered by this document.
+
+5. Compiling
+------------
+To recompile Perl just cd to the directory with sources and type:
+
+ configure
+
+The script will ask you many questions, it is ok to give default answers. Of
+course, you are free to play with those options, but i can't guarantee anything
+in this case. To the last question ("Run make depend now?") answer "n".
+
+Unfortunately there are problems with PD Korn shell, which result in incorrect
+behavour of "makedepend" script. To fix them you need to edit the script and
+replace "$cat" everywhere in it with "/bin/cat".
+
+After that you can safely type:
+
+ make depend
+
+And when the process finishes you can enter:
+
+ make
+
+After compiling you may run test suite by typing:
+
+ make test
+
+On my system only one test fails - lib/findbin. This is a result of
+ixemul.library's bug and not Perl's one. See detailed description in section 6.
+
+Install the compiled program by using:
+
+ make install.perl
+ make install.man
+
+I use make v3.80 and it seems to have a bug because "make install" does not
+work. Make just says that "Target install is up to date" and does nothing. If i
+rename the target so something, for example "install1", it starts to work. So
+you are free to try, may be you'll be more lucky.
+
+To clean up the distribution (erase all binary and #?.o files) you can use:
+
+ make distclean
+
+6. Known problems.
+------------------
+There are two known problems with this version of Perl on MorphOS. Both of them
+are caused by bugs in ixemul.library version 49.7:
+
+- FindBin module will fail. The problem is that ixemul.library incorrectly
+handles virtual filesystem root ("/"). You can't list it, examine entries in it
+and even go to it from inner level (using "cd .."). FindBin module works by
+traversing from current directory up to the root and then searching there. This
+ixemul.library bug prevents it from functioning.
+- This bug also prevented getcwd and fastcwd from Cwd module from functioning
+because they use algorythm similar to FindBin. I've made a workaround for this
+by redirecting those function to cwd which works normally. Hopefully this will
+not cause any side effects.
+- Second problem affects perlio I/O abstraction layer. It itself makes it
+impossible to use FILE* contents. It is likely caused by bug in ungetc()
+function of ixemul.library. As a workaround "d_stdstdio" parameter is set to
+"undef" in hints/morphos.sh despite configure script suggests to "define" it. If
+you choose to do so you'll get a lot of warnings like "Setting cnt to xxx
+implies ptr yyy". This message means that values in FILE* are inconsistent. But
+for Perl programs this should not cause any problems except I/O is a little
+slower.
+
+7. Port author
+---------
+My name is Pavel Fedin, i live in Russia, and you can always reach me by
+E-Mail:
+
+ sonic_amiga@rambler.ru
diff -ruN perl-5.6.1-orig/bug.txt perl-5.6.1/bug.txt
--- perl-5.6.1-orig/bug.txt Thu Jan 1 00:00:00 1970
+++ perl-5.6.1/bug.txt Sun Aug 29 22:10:17 2004
@@ -0,0 +1 @@
+lib-findbin
diff -ruN perl-5.6.1-orig/build.log perl-5.6.1/build.log
--- perl-5.6.1-orig/build.log Thu Jan 1 00:00:00 1970
+++ perl-5.6.1/build.log Thu Aug 19 21:43:30 2004
@@ -0,0 +1,38 @@
+`sh cflags libperl.a miniperlmain.o` miniperlmain.c
+`sh cflags libperl.a perl.o` perl.c
+`sh cflags libperl.a gv.o` gv.c
+`sh cflags libperl.a toke.o` toke.c
+`sh cflags libperl.a perly.o` perly.c
+`sh cflags libperl.a op.o` op.c
+`sh cflags libperl.a regcomp.o` regcomp.c
+`sh cflags libperl.a dump.o` dump.c
+`sh cflags libperl.a util.o` util.c
+`sh cflags libperl.a mg.o` mg.c
+`sh cflags libperl.a hv.o` hv.c
+`sh cflags libperl.a av.o` av.c
+`sh cflags libperl.a run.o` run.c
+`sh cflags libperl.a pp_hot.o` pp_hot.c
+`sh cflags libperl.a sv.o` sv.c
+`sh cflags libperl.a pp.o` pp.c
+`sh cflags libperl.a scope.o` scope.c
+`sh cflags libperl.a pp_ctl.o` pp_ctl.c
+`sh cflags libperl.a pp_sys.o` pp_sys.c
+`sh cflags libperl.a doop.o` doop.c
+`sh cflags libperl.a doio.o` doio.c
+`sh cflags libperl.a regexec.o` regexec.c
+`sh cflags libperl.a utf8.o` utf8.c
+`sh cflags libperl.a taint.o` taint.c
+`sh cflags libperl.a deb.o` deb.c
+`sh cflags libperl.a universal.o` universal.c
+`sh cflags libperl.a xsutils.o` xsutils.c
+`sh cflags libperl.a globals.o` globals.c
+`sh cflags libperl.a perlio.o` perlio.c
+`sh cflags libperl.a perlapi.o` perlapi.c
+rm -f libperl.a
+/bin/ar rcu libperl.a perl.o gv.o toke.o perly.o op.o regcomp.o dump.o util.o mg.o hv.o av.o run.o pp_hot.o sv.o pp.o scope.o pp_ctl.o pp_sys.o doop.o doio.o regexec.o utf8.o taint.o deb.o universal.o xsutils.o globals.o perlio.o perlapi.o
+rm -f opmini.c
+cp op.c opmini.c
+`sh cflags libperl.a opmini.o` -DPERL_EXTERNAL_GLOB opmini.c
+rm -f opmini.c
+gcc -L /gg/lib -lm -o miniperl \
+ miniperlmain.o opmini.o libperl.a
diff -ruN perl-5.6.1-orig/hints/morphos.sh perl-5.6.1/hints/morphos.sh
--- perl-5.6.1-orig/hints/morphos.sh Thu Jan 1 00:00:00 1970
+++ perl-5.6.1/hints/morphos.sh Wed Sep 1 23:06:14 2004
@@ -0,0 +1,54 @@
+# hints/morphos.sh
+#
+# created by Pavel Fedin <sonic_amiga@rambler.ru> based on hints/amigaos.sh.
+#
+# misc stuff
+archname='ppc-morphos'
+cc='gcc'
+firstmakefile='GNUmakefile'
+usenm='true'
+prefix='/gg'
+
+usemymalloc='n'
+usevfork='true'
+useperlio='true'
+d_eofnblk='define'
+d_fork='undef'
+d_vfork='define'
+groupstype='int'
+
+# libs
+
+libpth="$prefix/lib $prefix/ppc-morphos/lib"
+glibpth="$libpth"
+xlibpth="$libpth"
+loclibpth="$prefix/lib"
+
+# This should remove unwanted libraries instead of limiting the set
+# to just these few. E.g. what about Berkeley DB?
+libswanted='gdbm m dld'
+so=' '
+
+# compiler & linker flags
+# Respect command-line values.
+
+ccflags="$ccflags -DAMIGAOS -mstackextend"
+case "$optimize" in
+'') optimize='-O2 -fomit-frame-pointer';;
+esac
+dlext='o'
+# Are these two different from the defaults?
+cccdlflags='none'
+ccdlflags='none'
+lddlflags='-r'
+
+#Override ungetc() bug
+d_stdstdio='undef'
+
+# MorphOS always reports only two links to directories, even if they
+# contain subdirectories. Consequently, we use this variable to stop
+# File::Find using the link count to determine whether there are
+# subdirectories to be searched. This will generate a harmless message:
+# Hmm...You had some extra variables I don't know about...I'll try to keep 'em.
+# Propagating recommended variable dont_use_nlink
+dont_use_nlink='define'
diff -ruN perl-5.6.1-orig/installman perl-5.6.1/installman
--- perl-5.6.1-orig/installman Fri Feb 23 02:57:55 2001
+++ perl-5.6.1/installman Wed Sep 1 22:52:39 2004
@@ -147,7 +147,7 @@
# Convert name from File/Basename.pm to File::Basename.3 format,
# if necessary.
$manpage =~ s#\.p(m|od)$##;
- if ($^O eq 'os2' || $^O eq 'amigaos' || $^O eq 'uwin' || $^O eq 'cygwin') {
+ if ($^O eq 'os2' || $^O eq 'amigaos' || $^O eq 'morphos' || $^O eq 'uwin' || $^O eq 'cygwin') {
$manpage =~ s#/#.#g;
}
else {
@@ -231,15 +231,18 @@
my($success) = 0;
print $opts{verbose} ? " ln $from $to\n" : " $to\n" unless $opts{silent};
- eval {
- CORE::link($from, $to)
- ? $success++
- : ($from =~ m#^/afs/# || $to =~ m#^/afs/#)
- ? die "AFS" # okay inside eval {}
- : warn "Couldn't link $from to $to: $!\n"
- unless $opts{notify};
+ if ($^O ne 'morphos')
+ {
+ eval {
+ CORE::link($from, $to)
+ ? $success++
+ : ($from =~ m#^/afs/# || $to =~ m#^/afs/#)
+ ? die "AFS" # okay inside eval {}
+ : warn "Couldn't link $from to $to: $!\n"
+ unless $opts{notify};
+ };
};
- if ($@) {
+ if ($@ || $^O eq 'morphos') {
File::Copy::copy($from, $to)
? $success++
: warn "Couldn't copy $from to $to: $!\n"
diff -ruN perl-5.6.1-orig/installperl perl-5.6.1/installperl
--- perl-5.6.1-orig/installperl Tue Mar 20 17:40:22 2001
+++ perl-5.6.1/installperl Thu Aug 19 23:00:35 2004
@@ -163,8 +163,7 @@
$installbin || die "No installbin directory in config.sh\n";
-d $installbin || mkpath($installbin, $verbose, 0777);
--d $installbin || $nonono || die "$installbin is not a directory\n";
--w $installbin || $nonono || die "$installbin is not writable by you\n"
+-d $installbin || $nonono || die "$installbin is not a directory\n"
unless $installbin =~ m#^/afs/# || $nonono;
-x 'perl' . $exe_ext || die "perl isn't executable!\n";
@@ -539,7 +538,7 @@
print $verbose ? " ln $from $to\n" : " $to\n" unless $silent;
eval {
- CORE::link($from, $to)
+ CORE::symlink($from, $to)
? $success++
: ($from =~ m#^/afs/# || $to =~ m#^/afs/#)
? die "AFS" # okay inside eval {}
diff -ruN perl-5.6.1-orig/lib/Cwd.pm perl-5.6.1/lib/Cwd.pm
--- perl-5.6.1-orig/lib/Cwd.pm Sun Apr 1 09:00:22 2001
+++ perl-5.6.1/lib/Cwd.pm Thu Aug 26 23:09:03 2004
@@ -106,6 +106,16 @@
else {
*cwd = \&getcwd;
}
+# This is a quick workaround to get all functions working on MorphOS with
+# broken "/" (root) handling in ixemul.library. I hope it really works
+ if ($^O eq 'morphos') {
+ *getcwd = \&_backtick_pwd;
+ *fastcwd = \&_backtick_pwd;
+ }
+ else {
+ *getcwd = \&_getcwd;
+ *fastcwd = \&_fastcwd;
+ }
}
# set a reasonable (and very safe) default for fastgetcwd, in case it
@@ -116,7 +126,7 @@
#
# Usage: $cwd = getcwd();
-sub getcwd
+sub _getcwd
{
abs_path('.');
}
@@ -128,7 +138,7 @@
# This is a faster version of getcwd. It's also more dangerous because
# you might chdir out of a directory that you can't chdir back into.
-sub fastcwd {
+sub _fastcwd {
my($odev, $oino, $cdev, $cino, $tdev, $tino);
my(@path, $path);
local(*DIR);
diff -ruN perl-5.6.1-orig/lib/File/Basename.pm perl-5.6.1/lib/File/Basename.pm
--- perl-5.6.1-orig/lib/File/Basename.pm Fri Feb 23 02:57:55 2001
+++ perl-5.6.1/lib/File/Basename.pm Thu Aug 12 21:16:36 2004
@@ -34,9 +34,9 @@
You select the syntax via the routine fileparse_set_fstype().
If the argument passed to it contains one of the substrings
-"VMS", "MSDOS", "MacOS", "AmigaOS" or "MSWin32", the file specification
-syntax of that operating system is used in future calls to
-fileparse(), basename(), and dirname(). If it contains none of
+"VMS", "MSDOS", "MacOS", "AmigaOS", "MorphOS" or "MSWin32", the file
+specification syntax of that operating system is used in future calls
+to fileparse(), basename(), and dirname(). If it contains none of
these substrings, Unix syntax is used. This pattern matching is
case-insensitive. If you've selected VMS syntax, and the file
specification you pass to one of these routines contains a "/",
@@ -44,10 +44,10 @@
rules instead, for that function call only.
If the argument passed to it contains one of the substrings "VMS",
-"MSDOS", "MacOS", "AmigaOS", "os2", "MSWin32" or "RISCOS", then the pattern
-matching for suffix removal is performed without regard for case,
-since those systems are not case-sensitive when opening existing files
-(though some of them preserve case on file creation).
+"MSDOS", "MacOS", "AmigaOS", "MorphOS", "os2", "MSWin32" or "RISCOS",
+then the pattern matching for suffix removal is performed without
+regard for case, since those systems are not case-sensitive when opening
+existing files (though some of them preserve case on file creation).
If you haven't called fileparse_set_fstype(), the syntax is chosen
by examining the builtin variable C<$^O> according to these rules.
@@ -146,14 +146,14 @@
# fileparse_set_fstype() - specify OS-based rules used in future
# calls to routines in this package
#
-# Currently recognized values: VMS, MSDOS, MacOS, AmigaOS, os2, RISCOS
+# Currently recognized values: VMS, MSDOS, MacOS, AmigaOS, MorphOS, os2, RISCOS
# Any other name uses Unix-style rules and is case-sensitive
sub fileparse_set_fstype {
my @old = ($Fileparse_fstype, $Fileparse_igncase);
if (@_) {
$Fileparse_fstype = $_[0];
- $Fileparse_igncase = ($_[0] =~ /^(?:MacOS|VMS|AmigaOS|os2|RISCOS|MSWin32|MSDOS)/i);
+ $Fileparse_igncase = ($_[0] =~ /^(?:MacOS|VMS|AmigaOS|MorphOS|os2|RISCOS|MSWin32|MSDOS)/i);
}
wantarray ? @old : $old[0];
}
@@ -183,7 +183,7 @@
elsif ($fstype =~ /^MacOS/si) {
($dirpath,$basename) = ($fullname =~ /^(.*:)?(.*)/s);
}
- elsif ($fstype =~ /^AmigaOS/i) {
+ elsif ($fstype =~ /^(?:AmigaOS|MorphOS)/i) {
($dirpath,$basename) = ($fullname =~ /(.*[:\/])?(.*)/s);
$dirpath = './' unless $dirpath;
}
@@ -261,7 +261,7 @@
$dirname =~ s/([^:])[\\\/]*\z/$1/;
}
}
- elsif ($fstype =~ /AmigaOS/i) {
+ elsif ($fstype =~ /(?:AmigaOS|MorphOS)/i) {
if ( $dirname =~ /:\z/) { return $dirname }
chop $dirname;
$dirname =~ s#[^:/]+\z## unless length($basename);
diff -ruN perl-5.6.1-orig/lib/File/Find.pm perl-5.6.1/lib/File/Find.pm
--- perl-5.6.1-orig/lib/File/Find.pm Fri Feb 23 02:57:55 2001
+++ perl-5.6.1/lib/File/Find.pm Thu Aug 26 22:34:00 2004
@@ -758,7 +758,7 @@
}
$File::Find::dont_use_nlink = 1
- if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' ||
+ if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'morphos' || $^O eq 'MSWin32' ||
$^O eq 'cygwin' || $^O eq 'epoc';
# Set dont_use_nlink in your hint file if your system's stat doesn't
diff -ruN perl-5.6.1-orig/lib/File/Path.pm perl-5.6.1/lib/File/Path.pm
--- perl-5.6.1-orig/lib/File/Path.pm Tue Mar 20 17:40:22 2001
+++ perl-5.6.1/lib/File/Path.pm Thu Aug 12 21:17:52 2004
@@ -107,7 +107,7 @@
# These OSes complain if you want to remove a file that you have no
# write permission to:
my $force_writeable = ($^O eq 'os2' || $^O eq 'dos' || $^O eq 'MSWin32' ||
- $^O eq 'amigaos' || $^O eq 'MacOS' || $^O eq 'epoc');
+ $^O eq 'amigaos' || $^O eq 'morphos' || $^O eq 'MacOS' || $^O eq 'epoc');
sub mkpath {
my($paths, $verbose, $mode) = @_;
diff -ruN perl-5.6.1-orig/lib/File/Spec/MorphOS.pm perl-5.6.1/lib/File/Spec/MorphOS.pm
--- perl-5.6.1-orig/lib/File/Spec/MorphOS.pm Thu Jan 1 00:00:00 1970
+++ perl-5.6.1/lib/File/Spec/MorphOS.pm Sun Aug 29 19:24:41 2004
@@ -0,0 +1,458 @@
+package File::Spec::MorphOS;
+
+use strict;
+use vars qw($VERSION);
+
+$VERSION = '1.2';
+
+use Cwd;
+
+=head1 NAME
+
+File::Spec::Unix - methods used by File::Spec
+
+=head1 SYNOPSIS
+
+ require File::Spec::Unix; # Done automatically by File::Spec
+
+=head1 DESCRIPTION
+
+Methods for manipulating file specifications.
+
+=head1 METHODS
+
+=over 2
+
+=item canonpath
+
+No physical check on the filesystem, but a logical cleanup of a
+path. On UNIX eliminated successive slashes and successive "/.".
+
+ $cpath = File::Spec->canonpath( $path ) ;
+
+=cut
+
+sub canonpath {
+ my ($self,$path) = @_;
+ $path =~ s|/+|/|g unless($^O eq 'cygwin'); # xx////xx -> xx/xx
+ $path =~ s|(/\.)+/|/|g; # xx/././xx -> xx/xx
+ $path =~ s|^(\./)+||s unless $path eq "./"; # ./xx -> xx
+ $path =~ s|^/(\.\./)+|/|s; # /../../xx -> xx
+ $path =~ s|/\Z(?!\n)|| unless $path eq "/"; # xx/ -> xx
+ return $path;
+}
+
+=item catdir
+
+Concatenate two or more directory names to form a complete path ending
+with a directory. But remove the trailing slash from the resulting
+string, because it doesn't look good, isn't necessary and confuses
+OS2. Of course, if this is the root directory, don't cut off the
+trailing slash :-)
+
+=cut
+
+sub catdir {
+ my $self = shift;
+ my @args = @_;
+ foreach (@args) {
+ # append a slash to each argument unless it has one there
+ $_ .= "/" if $_ eq '' || substr($_,-1) ne "/";
+ }
+ return $self->canonpath(join('', @args));
+}
+
+=item catfile
+
+Concatenate one or more directory names and a filename to form a
+complete path ending with a filename
+
+=cut
+
+sub catfile {
+ my $self = shift;
+ my $file = pop @_;
+ return $file unless @_;
+ my $dir = $self->catdir(@_);
+ $dir .= "/" unless substr($dir,-1) eq "/";
+ return $dir.$file;
+}
+
+=item curdir
+
+Returns a string representation of the current directory. "." on UNIX.
+
+=cut
+
+sub curdir {
+ return ".";
+}
+
+=item devnull
+
+Returns a string representation of the null device. "/dev/null" on UNIX.
+
+=cut
+
+sub devnull {
+ return "/dev/null";
+}
+
+=item rootdir
+
+Returns a string representation of the root directory. "/" on UNIX.
+
+=cut
+
+sub rootdir {
+ return "/";
+}
+
+=item tmpdir
+
+Returns a string representation of the first writable directory
+from the following list or "" if none are writable:
+
+ $ENV{TMPDIR}
+ /tmp
+
+=cut
+
+my $tmpdir;
+sub tmpdir {
+ return $tmpdir if defined $tmpdir;
+ foreach ($ENV{TMPDIR}, "/tmp") {
+ next unless defined;
+ $tmpdir = $_;
+ last;
+ }
+ $tmpdir = '' unless defined $tmpdir;
+ return $tmpdir;
+}
+
+=item updir
+
+Returns a string representation of the parent directory. ".." on MorphOS.
+
+=cut
+
+sub updir {
+ return "..";
+}
+
+=item no_upwards
+
+Given a list of file names, strip out those that refer to a parent
+directory. (Does not strip symlinks, only '.', '..', and equivalents.)
+
+=cut
+
+sub no_upwards {
+ my $self = shift;
+ return grep(!/^\.{1,2}\Z(?!\n)/s, @_);
+}
+
+=item case_tolerant
+
+Returns a true or false value indicating, respectively, that alphabetic
+is not or is significant when comparing file specifications.
+
+=cut
+
+sub case_tolerant {
+ return 0;
+}
+
+=item file_name_is_absolute
+
+Takes as argument a path and returns true if it is an absolute path.
+
+This does not consult the local filesystem on Unix, Win32, or OS/2. It
+does sometimes on MacOS (see L<File::Spec::MacOS/file_name_is_absolute>).
+It does consult the working environment for VMS (see
+L<File::Spec::VMS/file_name_is_absolute>).
+
+=cut
+
+sub file_name_is_absolute {
+ my ($self,$file) = @_;
+ return scalar($file =~ m:^/:s);
+}
+
+=item path
+
+Takes no argument, returns the environment variable PATH as an array.
+
+=cut
+
+sub path {
+ my @path = split(':', $ENV{PATH});
+ foreach (@path) { $_ = '.' if $_ eq '' }
+ return @path;
+}
+
+=item join
+
+join is the same as catfile.
+
+=cut
+
+sub join {
+ my $self = shift;
+ return $self->catfile(@_);
+}
+
+=item splitpath
+
+ ($volume,$directories,$file) = File::Spec->splitpath( $path );
+ ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
+
+Splits a path in to volume, directory, and filename portions. On systems
+with no concept of volume, returns undef for volume.
+
+For systems with no syntax differentiating filenames from directories,
+assumes that the last file is a path unless $no_file is true or a
+trailing separator or /. or /.. is present. On Unix this means that $no_file
+true makes this return ( '', $path, '' ).
+
+The directory portion may or may not be returned with a trailing '/'.
+
+The results can be passed to L</catpath()> to get back a path equivalent to
+(usually identical to) the original path.
+
+=cut
+
+sub splitpath {
+ my ($self,$path, $nofile) = @_;
+
+ my ($volume,$directory,$file) = ('','','');
+
+ if ( $nofile ) {
+ $directory = $path;
+ }
+ else {
+ $path =~ m|^ ( (?: .* / (?: \.\.?\Z(?!\n) )? )? ) ([^/]*) |xs;
+ $directory = $1;
+ $file = $2;
+ }
+
+ return ($volume,$directory,$file);
+}
+
+
+=item splitdir
+
+The opposite of L</catdir()>.
+
+ @dirs = File::Spec->splitdir( $directories );
+
+$directories must be only the directory portion of the path on systems
+that have the concept of a volume or that have path syntax that differentiates
+files from directories.
+
+Unlike just splitting the directories on the separator, empty
+directory names (C<''>) can be returned, because these are significant
+on some OSs (e.g. MacOS).
+
+On Unix,
+
+ File::Spec->splitdir( "/a/b//c/" );
+
+Yields:
+
+ ( '', 'a', 'b', '', 'c', '' )
+
+=cut
+
+sub splitdir {
+ my ($self,$directories) = @_ ;
+ #
+ # split() likes to forget about trailing null fields, so here we
+ # check to be sure that there will not be any before handling the
+ # simple case.
+ #
+ if ( $directories !~ m|/\Z(?!\n)| ) {
+ return split( m|/|, $directories );
+ }
+ else {
+ #
+ # since there was a trailing separator, add a file name to the end,
+ # then do the split, then replace it with ''.
+ #
+ my( @directories )= split( m|/|, "${directories}dummy" ) ;
+ $directories[ $#directories ]= '' ;
+ return @directories ;
+ }
+}
+
+
+=item catpath
+
+Takes volume, directory and file portions and returns an entire path. Under
+Unix, $volume is ignored, and directory and file are catenated. A '/' is
+inserted if need be. On other OSs, $volume is significant.
+
+=cut
+
+sub catpath {
+ my ($self,$volume,$directory,$file) = @_;
+
+ if ( $directory ne '' &&
+ $file ne '' &&
+ substr( $directory, -1 ) ne '/' &&
+ substr( $file, 0, 1 ) ne '/'
+ ) {
+ $directory .= "/$file" ;
+ }
+ else {
+ $directory .= $file ;
+ }
+
+ return $directory ;
+}
+
+=item abs2rel
+
+Takes a destination path and an optional base path returns a relative path
+from the base path to the destination path:
+
+ $rel_path = File::Spec->abs2rel( $path ) ;
+ $rel_path = File::Spec->abs2rel( $path, $base ) ;
+
+If $base is not present or '', then L<cwd()> is used. If $base is relative,
+then it is converted to absolute form using L</rel2abs()>. This means that it
+is taken to be relative to L<cwd()>.
+
+On systems with the concept of a volume, this assumes that both paths
+are on the $destination volume, and ignores the $base volume.
+
+On systems that have a grammar that indicates filenames, this ignores the
+$base filename as well. Otherwise all path components are assumed to be
+directories.
+
+If $path is relative, it is converted to absolute form using L</rel2abs()>.
+This means that it is taken to be relative to L<cwd()>.
+
+No checks against the filesystem are made on most systems. On MacOS,
+the filesystem may be consulted (see
+L<File::Spec::MacOS/file_name_is_absolute>). On VMS, there is
+interaction with the working environment, as logicals and
+macros are expanded.
+
+Based on code written by Shigio Yamaguchi.
+
+=cut
+
+sub abs2rel {
+ my($self,$path,$base) = @_;
+
+ # Clean up $path
+ if ( ! $self->file_name_is_absolute( $path ) ) {
+ $path = $self->rel2abs( $path ) ;
+ }
+ else {
+ $path = $self->canonpath( $path ) ;
+ }
+
+ # Figure out the effective $base and clean it up.
+ if ( !defined( $base ) || $base eq '' ) {
+ $base = cwd() ;
+ }
+ elsif ( ! $self->file_name_is_absolute( $base ) ) {
+ $base = $self->rel2abs( $base ) ;
+ }
+ else {
+ $base = $self->canonpath( $base ) ;
+ }
+
+ # Now, remove all leading components that are the same
+ my @pathchunks = $self->splitdir( $path);
+ my @basechunks = $self->splitdir( $base);
+
+ while (@pathchunks && @basechunks && $pathchunks[0] eq $basechunks[0]) {
+ shift @pathchunks ;
+ shift @basechunks ;
+ }
+
+ $path = CORE::join( '/', @pathchunks );
+ $base = CORE::join( '/', @basechunks );
+
+ # $base now contains the directories the resulting relative path
+ # must ascend out of before it can descend to $path_directory. So,
+ # replace all names with $parentDir
+ $base =~ s|[^/]+|..|g ;
+
+ # Glue the two together, using a separator if necessary, and preventing an
+ # empty result.
+ if ( $path ne '' && $base ne '' ) {
+ $path = "$base/$path" ;
+ } else {
+ $path = "$base$path" ;
+ }
+
+ return $self->canonpath( $path ) ;
+}
+
+=item rel2abs
+
+Converts a relative path to an absolute path.
+
+ $abs_path = File::Spec->rel2abs( $path ) ;
+ $abs_path = File::Spec->rel2abs( $path, $base ) ;
+
+If $base is not present or '', then L<cwd()> is used. If $base is relative,
+then it is converted to absolute form using L</rel2abs()>. This means that it
+is taken to be relative to L<cwd()>.
+
+On systems with the concept of a volume, this assumes that both paths
+are on the $base volume, and ignores the $path volume.
+
+On systems that have a grammar that indicates filenames, this ignores the
+$base filename as well. Otherwise all path components are assumed to be
+directories.
+
+If $path is absolute, it is cleaned up and returned using L</canonpath()>.
+
+No checks against the filesystem are made on most systems. On MacOS,
+the filesystem may be consulted (see
+L<File::Spec::MacOS/file_name_is_absolute>). On VMS, there is
+interaction with the working environment, as logicals and
+macros are expanded.
+
+Based on code written by Shigio Yamaguchi.
+
+=cut
+
+sub rel2abs {
+ my ($self,$path,$base ) = @_;
+
+ # Clean up $path
+ if ( ! $self->file_name_is_absolute( $path ) ) {
+ # Figure out the effective $base and clean it up.
+ if ( !defined( $base ) || $base eq '' ) {
+ $base = cwd() ;
+ }
+ elsif ( ! $self->file_name_is_absolute( $base ) ) {
+ $base = $self->rel2abs( $base ) ;
+ }
+ else {
+ $base = $self->canonpath( $base ) ;
+ }
+
+ # Glom them together
+ $path = $self->catdir( $base, $path ) ;
+ }
+
+ return $self->canonpath( $path ) ;
+}
+
+
+=back
+
+=head1 SEE ALSO
+
+L<File::Spec>
+
+=cut
+
+1;
diff -ruN perl-5.6.1-orig/lib/File/Spec/Unix.pm perl-5.6.1/lib/File/Spec/Unix.pm
--- perl-5.6.1-orig/lib/File/Spec/Unix.pm Fri Feb 23 02:57:55 2001
+++ perl-5.6.1/lib/File/Spec/Unix.pm Sun Aug 29 18:49:03 2004
@@ -122,6 +122,10 @@
sub tmpdir {
return $tmpdir if defined $tmpdir;
foreach ($ENV{TMPDIR}, "/tmp") {
+ print "Checking ",$_,"\n";
+ print defined,"\n";
+ print -d,"\n";
+ print -w,"\n";
next unless defined && -d && -w _;
$tmpdir = $_;
last;
diff -ruN perl-5.6.1-orig/lib/File/Spec.pm perl-5.6.1/lib/File/Spec.pm
--- perl-5.6.1-orig/lib/File/Spec.pm Fri Feb 23 02:57:55 2001
+++ perl-5.6.1/lib/File/Spec.pm Sun Aug 29 18:52:29 2004
@@ -9,7 +9,8 @@
MSWin32 => 'Win32',
os2 => 'OS2',
VMS => 'VMS',
- epoc => 'Epoc');
+ epoc => 'Epoc',
+ morphos => 'MorphOS');
my $module = $module{$^O} || 'Unix';
require "File/Spec/$module.pm";
diff -ruN perl-5.6.1-orig/lib/File/Temp.pm perl-5.6.1/lib/File/Temp.pm
--- perl-5.6.1-orig/lib/File/Temp.pm Sat Mar 3 19:53:20 2001
+++ perl-5.6.1/lib/File/Temp.pm Sun Aug 29 21:36:20 2004
@@ -404,9 +404,11 @@
${$options{ErrStr}} = "Parent directory ($parent) is not a directory";
return ();
}
- unless (-w _) {
- ${$options{ErrStr}} = "Parent directory ($parent) is not writable\n";
- return ();
+ if ($^O ne 'morphos') {
+ unless (-w _) {
+ ${$options{ErrStr}} = "Parent directory ($parent) is not writable\n";
+ return ();
+ }
}
@@ -649,14 +651,17 @@
# Check to see whether owner is neither superuser (or a system uid) nor me
# Use the real uid from the $< variable
# UID is in [4]
- if ($info[4] > File::Temp->top_system_uid() && $info[4] != $<) {
-
- Carp::cluck(sprintf "uid=$info[4] topuid=%s \$<=$< path='$path'",
- File::Temp->top_system_uid());
-
- $$err_ref = "Directory owned neither by root nor the current user"
- if ref($err_ref);
- return 0;
+ if ($^O ne 'amigaos' && $^O ne 'morphos')
+ {
+ if ($info[4] > File::Temp->top_system_uid() && $info[4] != $<) {
+
+ Carp::cluck(sprintf "uid=$info[4] topuid=%s \$<=$< path='$path'",
+ File::Temp->top_system_uid());
+
+ $$err_ref = "Directory owned neither by root nor the current user"
+ if ref($err_ref);
+ return 0;
+ }
}
# check whether group or other can write file
diff -ruN perl-5.6.1-orig/lib/Term/ReadLine.pm perl-5.6.1/lib/Term/ReadLine.pm
--- perl-5.6.1-orig/lib/Term/ReadLine.pm Fri Feb 23 02:57:55 2001
+++ perl-5.6.1/lib/Term/ReadLine.pm Thu Aug 12 21:21:06 2004
@@ -197,7 +197,7 @@
$console = "sys\$command";
}
- if (($^O eq 'amigaos') || ($^O eq 'beos') || ($^O eq 'epoc')) {
+ if (($^O eq 'amigaos') || ($^O eq 'morphos') || ($^O eq 'beos') || ($^O eq 'epoc')) {
$console = undef;
}
elsif ($^O eq 'os2') {
diff -ruN perl-5.6.1-orig/lib/perl5db.pl perl-5.6.1/lib/perl5db.pl
--- perl-5.6.1-orig/lib/perl5db.pl Fri Feb 23 02:57:55 2001
+++ perl-5.6.1/lib/perl5db.pl Thu Aug 12 21:02:18 2004
@@ -2510,7 +2510,7 @@
}
sub setman {
- $doccmd = $^O !~ /^(?:MSWin32|VMS|os2|dos|amigaos|riscos|MacOS)\z/s
+ $doccmd = $^O !~ /^(?:MSWin32|VMS|os2|dos|amigaos|morphos|riscos|MacOS)\z/s
? "man" # O Happy Day!
: "perldoc"; # Alas, poor unfortunates
}
diff -ruN perl-5.6.1-orig/t/io/fs.t perl-5.6.1/t/io/fs.t
--- perl-5.6.1-orig/t/io/fs.t Sat Mar 3 19:53:20 2001
+++ perl-5.6.1/t/io/fs.t Wed Aug 25 21:48:35 2004
@@ -12,6 +12,8 @@
$Is_Dosish = ($^O eq 'MSWin32' or $^O eq 'dos' or
$^O eq 'os2' or $^O eq 'mint');
+$No_Link = ($Is_Dosish || $^O eq 'morphos');
+
if (defined &Win32::IsWinNT && Win32::IsWinNT()) {
$Is_Dosish = '' if Win32::FsType() eq 'NTFS';
}
@@ -35,24 +37,24 @@
open(fh,'>a') || die "Can't create a";
close(fh);
-if ($Is_Dosish) {print "ok 2 # skipped: no link\n";}
+if ($No_Link) {print "ok 2 # skipped: no link\n";}
elsif (eval {link('a','b')}) {print "ok 2\n";}
else {print "not ok 2\n";}
-if ($Is_Dosish) {print "ok 3 # skipped: no link\n";}
+if ($No_Link) {print "ok 3 # skipped: no link\n";}
elsif (eval {link('b','c')}) {print "ok 3\n";}
else {print "not ok 3\n";}
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
$blksize,$blocks) = stat('c');
-if ($Config{dont_use_nlink} || $Is_Dosish)
+if ($Config{dont_use_nlink} || $No_Link)
{print "ok 4 # skipped: no link\n";}
elsif ($nlink == 3)
{print "ok 4\n";}
else {print "not ok 4\n";}
-if ($^O eq 'amigaos' || $Is_Dosish)
+if ($^O eq 'amigaos' || $No_Link)
{print "ok 5 # skipped: no link\n";}
elsif (($mode & 0777) == 0666)
{print "ok 5\n";}
@@ -63,7 +65,7 @@
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
$blksize,$blocks) = stat('c');
-if ($Is_Dosish) {print "ok 7 # skipped: no link\n";}
+if ($No_Link) {print "ok 7 # skipped: no link\n";}
elsif (($mode & 0777) == $newmode) {print "ok 7\n";}
else {print "not ok 7\n";}
@@ -73,23 +75,23 @@
$newmode = 0666;
}
-if ($Is_Dosish) {print "ok 8 # skipped: no link\n";}
+if ($No_Link) {print "ok 8 # skipped: no link\n";}
elsif ((chmod $newmode,'c','x') == 2) {print "ok 8\n";}
else {print "not ok 8\n";}
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
$blksize,$blocks) = stat('c');
-if ($Is_Dosish) {print "ok 9 # skipped: no link\n";}
+if ($No_Link) {print "ok 9 # skipped: no link\n";}
elsif (($mode & 0777) == $newmode) {print "ok 9\n";}
else {print "not ok 9\n";}
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
$blksize,$blocks) = stat('x');
-if ($Is_Dosish) {print "ok 10 # skipped: no link\n";}
+if ($No_Link) {print "ok 10 # skipped: no link\n";}
elsif (($mode & 0777) == $newmode) {print "ok 10\n";}
else {print "not ok 10\n";}
-if ($Is_Dosish) {print "ok 11 # skipped: no link\n"; unlink 'b','x'; }
+if ($No_Link) {print "ok 11 # skipped: no link\n"; unlink 'b','x'; }
elsif ((unlink 'b','x') == 2) {print "ok 11\n";}
else {print "not ok 11\n";}
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
@@ -111,7 +113,7 @@
$blksize,$blocks) = stat('b');
if ($^O eq 'MSWin32') { print "ok 17 # skipped: bogus (stat)[1]\n"; }
elsif ($ino) {print "ok 17\n";} else {print "not ok 17\n";}
-if ($wd =~ m#/afs/# || $^O eq 'amigaos' || $^O eq 'dos' || $^O eq 'MSWin32')
+if ($wd =~ m#/afs/# || $^O eq 'amigaos' || $^O eq 'morphos' || $^O eq 'dos' || $^O eq 'MSWin32')
{print "ok 18 # skipped: granularity of the filetime\n";}
elsif ($atime == 500000000 && $mtime == 500000000 + $delta)
{print "ok 18\n";}
diff -ruN perl-5.6.1-orig/t/lib/anydbm.t perl-5.6.1/t/lib/anydbm.t
--- perl-5.6.1-orig/t/lib/anydbm.t Fri Feb 23 02:57:57 2001
+++ perl-5.6.1/t/lib/anydbm.t Thu Aug 12 21:24:03 2004
@@ -16,7 +16,7 @@
print "1..12\n";
-$Is_Dosish = ($^O eq 'amigaos' || $^O eq 'MSWin32' or $^O eq 'dos' or
+$Is_Dosish = ($^O eq 'amigaos' || $^O eq 'morphos' || $^O eq 'MSWin32' or $^O eq 'dos' or
$^O eq 'os2' or $^O eq 'mint');
unlink <Op_dbmx*>;
diff -ruN perl-5.6.1-orig/t/lib/db-btree.t perl-5.6.1/t/lib/db-btree.t
--- perl-5.6.1-orig/t/lib/db-btree.t Fri Feb 23 02:57:57 2001
+++ perl-5.6.1/t/lib/db-btree.t Thu Aug 12 21:24:30 2004
@@ -142,7 +142,7 @@
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
$blksize,$blocks) = stat($Dfile);
-ok(20, ($mode & 0777) == ($^O eq 'os2' ? 0666 : 0640) || $^O eq 'amigaos' || $^O eq 'MSWin32');
+ok(20, ($mode & 0777) == ($^O eq 'os2' ? 0666 : 0640) || $^O eq 'amigaos' || $^O eq 'morphos' || $^O eq 'MSWin32');
my ($key, $value, $i);
while (($key,$value) = each(%h)) {
diff -ruN perl-5.6.1-orig/t/lib/db-hash.t perl-5.6.1/t/lib/db-hash.t
--- perl-5.6.1-orig/t/lib/db-hash.t Fri Feb 23 02:57:57 2001
+++ perl-5.6.1/t/lib/db-hash.t Thu Aug 12 21:27:31 2004
@@ -108,7 +108,7 @@
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
$blksize,$blocks) = stat($Dfile);
-ok(16, ($mode & 0777) == ($^O eq 'os2' ? 0666 : 0640) || $^O eq 'amigaos' || $^O eq 'MSWin32');
+ok(16, ($mode & 0777) == ($^O eq 'os2' ? 0666 : 0640) || $^O eq 'amigaos' || $^O eq 'morphos' || $^O eq 'MSWin32');
my ($key, $value, $i);
while (($key,$value) = each(%h)) {
diff -ruN perl-5.6.1-orig/t/lib/db-recno.t perl-5.6.1/t/lib/db-recno.t
--- perl-5.6.1-orig/t/lib/db-recno.t Fri Feb 23 02:57:57 2001
+++ perl-5.6.1/t/lib/db-recno.t Thu Aug 12 21:27:15 2004
@@ -153,7 +153,7 @@
ok(17, $X = tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO ) ;
ok(18, ((stat($Dfile))[2] & 0777) == ($^O eq 'os2' ? 0666 : 0640)
- || $^O eq 'MSWin32' || $^O eq 'amigaos') ;
+ || $^O eq 'MSWin32' || $^O eq 'amigaos' || $^O eq 'morphos') ;
#my $l = @h ;
my $l = $X->length ;
diff -ruN perl-5.6.1-orig/t/lib/filehand.t perl-5.6.1/t/lib/filehand.t
--- perl-5.6.1-orig/t/lib/filehand.t Tue Mar 20 17:40:22 2001
+++ perl-5.6.1/t/lib/filehand.t Thu Aug 12 21:26:59 2004
@@ -72,7 +72,7 @@
($rd,$wr) = FileHandle::pipe;
-if ($^O eq 'VMS' || $^O eq 'os2' || $^O eq 'amigaos' || $^O eq 'MSWin32' ||
+if ($^O eq 'VMS' || $^O eq 'os2' || $^O eq 'amigaos' || $^O eq 'morphos' || $^O eq 'MSWin32' ||
$Config{d_fork} ne 'define') {
$wr->autoflush;
$wr->printf("ok %d\n",11);
diff -ruN perl-5.6.1-orig/t/lib/ftmp-tempfile.t perl-5.6.1/t/lib/ftmp-tempfile.t
--- perl-5.6.1-orig/t/lib/ftmp-tempfile.t Fri Feb 23 02:57:57 2001
+++ perl-5.6.1/t/lib/ftmp-tempfile.t Sun Aug 29 21:27:44 2004
@@ -42,10 +42,10 @@
# Now we start the tests properly
ok(1);
-
# Tempfile
# Open tempfile in some directory, unlink at end
my ($fh, $tempfile) = tempfile(
+ DIR => '/tmp',
UNLINK => 1,
SUFFIX => '.txt',
);
@@ -125,8 +125,7 @@
# on NFS
# Try to do what we can.
# Tempfile croaks on error so we need an eval
-$fh = eval { tempfile( 'ftmpXXXXX', DIR => File::Spec->tmpdir ) };
-
+($fh, $tempfile) = eval { tempfile( 'ftmpXXXXX', DIR => File::Spec->tmpdir ) };
if ($fh) {
# print something to it to make sure something is there
diff -ruN perl-5.6.1-orig/t/lib/gdbm.t perl-5.6.1/t/lib/gdbm.t
--- perl-5.6.1-orig/t/lib/gdbm.t Mon Mar 19 08:10:30 2001
+++ perl-5.6.1/t/lib/gdbm.t Thu Aug 12 21:26:13 2004
@@ -29,7 +29,7 @@
if (! -e $Dfile) {
($Dfile) = <Op.dbmx*>;
}
-if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos') {
+if ($^O eq 'amigaos' || $^O eq 'morphos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos') {
print "ok 2 # Skipped: different file permission semantics\n";
}
else {
diff -ruN perl-5.6.1-orig/t/lib/glob-basic.t perl-5.6.1/t/lib/glob-basic.t
--- perl-5.6.1-orig/t/lib/glob-basic.t Mon Apr 2 05:18:41 2001
+++ perl-5.6.1/t/lib/glob-basic.t Fri Aug 27 01:03:31 2004
@@ -79,7 +79,7 @@
# check bad protections
# should return an empty list, and set ERROR
if ($^O eq 'mpeix' or $^O eq 'MSWin32' or $^O eq 'os2' or $^O eq 'VMS'
- or $^O eq 'cygwin' or Cwd::cwd() =~ m#^/afs#s or not $>)
+ or $^O eq 'cygwin' or $^O eq 'morphos' or Cwd::cwd() =~ m#^/afs#s or not $>)
{
print "ok 6 # skipped\n";
}
@@ -89,6 +89,7 @@
@a = bsd_glob("$dir/*", GLOB_ERR);
#print "\@a = ", array(@a);
rmdir $dir;
+ print scalar(@a)," ",GLOB_ERROR,"\n";
if (scalar(@a) != 0 || GLOB_ERROR == 0) {
print "not ";
}
@@ -110,7 +111,6 @@
# Working on t/TEST often causes this test to fail because it sees temp
# and RCS files. Filter them out, and .pm files too.
@a = grep !/(,v$|~$|\.pm$)/, @a;
-
unless (@a == 3
and $a[0] eq ($^O eq 'VMS'? 'test.' : 'TEST')
and $a[1] eq 'a'
diff -ruN perl-5.6.1-orig/t/lib/ipc_sysv.t perl-5.6.1/t/lib/ipc_sysv.t
--- perl-5.6.1-orig/t/lib/ipc_sysv.t Fri Feb 23 02:57:57 2001
+++ perl-5.6.1/t/lib/ipc_sysv.t Fri Aug 27 00:08:32 2004
@@ -16,6 +16,9 @@
} elsif ($Config{'d_msg'} ne 'define') {
$reason = '$Config{d_msg} undefined';
}
+ if ($^O eq 'amigaos' || $^O eq 'morphos') {
+ $reason = 'Not supported on this system';
+ }
if ($reason) {
print "1..0 # Skip: $reason\n";
exit 0;
diff -ruN perl-5.6.1-orig/t/lib/ndbm.t perl-5.6.1/t/lib/ndbm.t
--- perl-5.6.1-orig/t/lib/ndbm.t Mon Mar 19 08:10:30 2001
+++ perl-5.6.1/t/lib/ndbm.t Thu Aug 12 21:25:52 2004
@@ -40,7 +40,7 @@
if (! -e $Dfile) {
($Dfile) = <Op.dbmx*>;
}
-if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32') {
+if ($^O eq 'amigaos' || $^O eq 'morphos' || $^O eq 'os2' || $^O eq 'MSWin32') {
print "ok 2 # Skipped: different file permission semantics\n";
}
else {
diff -ruN perl-5.6.1-orig/t/lib/odbm.t perl-5.6.1/t/lib/odbm.t
--- perl-5.6.1-orig/t/lib/odbm.t Mon Mar 19 08:10:30 2001
+++ perl-5.6.1/t/lib/odbm.t Thu Aug 12 21:25:28 2004
@@ -40,7 +40,7 @@
if (! -e $Dfile) {
($Dfile) = <Op.dbmx*>;
}
-if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32') {
+if ($^O eq 'amigaos' || $^O eq 'morphos' || $^O eq 'os2' || $^O eq 'MSWin32') {
print "ok 2 # Skipped: different file permission semantics\n";
}
else {
diff -ruN perl-5.6.1-orig/t/lib/sdbm.t perl-5.6.1/t/lib/sdbm.t
--- perl-5.6.1-orig/t/lib/sdbm.t Mon Mar 19 08:10:30 2001
+++ perl-5.6.1/t/lib/sdbm.t Thu Aug 12 21:25:04 2004
@@ -40,7 +40,7 @@
if (! -e $Dfile) {
($Dfile) = <Op_dbmx.*>;
}
-if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos') {
+if ($^O eq 'amigaos' || $^O eq 'morphos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos') {
print "ok 2 # Skipped: different file permission semantics\n";
}
else {
diff -ruN perl-5.6.1-orig/t/op/grent.t perl-5.6.1/t/op/grent.t
--- perl-5.6.1-orig/t/op/grent.t Fri Feb 23 02:57:58 2001
+++ perl-5.6.1/t/op/grent.t Wed Aug 25 22:35:50 2004
@@ -42,11 +42,15 @@
}
if (not defined $where) { # Try local.
- my $GR = "/etc/group";
- if (-f $GR && open(GR, $GR) && defined(<GR>)) {
- undef $reason;
- $where = $GR;
- }
+ if ($^O eq 'amigaos' || $^O eq 'morphos') {
+ $reason = 'Unable to handle /etc/group on AmigaOS, please fix me';
+ } else {
+ my $GR = "/etc/group";
+ if (-f $GR && open(GR, $GR) && defined(<GR>)) {
+ undef $reason;
+ $where = $GR;
+ }
+ }
}
if ($reason) {
print "1..0 # Skip: $reason\n";
diff -ruN perl-5.6.1-orig/t/op/pwent.t perl-5.6.1/t/op/pwent.t
--- perl-5.6.1-orig/t/op/pwent.t Sun Apr 8 06:09:16 2001
+++ perl-5.6.1/t/op/pwent.t Wed Aug 25 22:20:22 2004
@@ -42,10 +42,14 @@
}
if (not defined $where) { # Try local.
- my $PW = "/etc/passwd";
- if (-f $PW && open(PW, $PW) && defined(<PW>)) {
- $where = $PW;
- undef $reason;
+ if ($^O eq 'amigaos' || $^O eq 'morphos') {
+ $reason = 'Unable to handle /etc/passwd on AmigaOS, please fix me';
+ } else {
+ my $PW = "/etc/passwd";
+ if (-f $PW && open(PW, $PW) && defined(<PW>)) {
+ $where = $PW;
+ undef $reason;
+ }
}
}
diff -ruN perl-5.6.1-orig/t/op/stat.t perl-5.6.1/t/op/stat.t
--- perl-5.6.1-orig/t/op/stat.t Mon Mar 19 07:33:17 2001
+++ perl-5.6.1/t/op/stat.t Wed Aug 25 22:37:44 2004
@@ -13,11 +13,12 @@
$Is_MSWin32 = $^O eq 'MSWin32';
$Is_Dos = $^O eq 'dos';
+$Is_Amiga = $^O eq 'amigaos' || $^O eq 'morphos';
$Is_Dosish = $Is_Dos || $^O eq 'os2' || $Is_MSWin32;
$Is_Cygwin = $^O eq 'cygwin';
chop($cwd = ($Is_MSWin32 ? `cd` : `pwd`));
-$DEV = `ls -l /dev` unless $Is_Dosish or $Is_Cygwin;
+$DEV = `ls -l /dev` unless $Is_Dosish or $Is_Cygwin or $Is_Amiga;
unlink "Op.stat.tmp";
if (open(FOO, ">Op.stat.tmp")) {
@@ -52,7 +53,7 @@
print "# open failed: $!\nnot ok 1\nnot ok 2\n";
}
-if ($Is_Dosish) { unlink "Op.stat.tmp2"}
+if ($Is_Dosish || $^O eq 'morphos') { unlink "Op.stat.tmp2"}
else {
`rm -f Op.stat.tmp2;ln Op.stat.tmp Op.stat.tmp2; chmod 644 Op.stat.tmp`;
}
@@ -60,7 +61,7 @@
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
$blksize,$blocks) = stat('Op.stat.tmp');
-if ($Is_Dosish || $Config{dont_use_nlink})
+if ($Is_Dosish || $Config{dont_use_nlink} || $^O eq 'morphos')
{print "ok 3 # skipped: no link count\n";}
elsif ($nlink == 2)
{print "ok 3\n";}
@@ -70,7 +71,8 @@
# Solaris tmpfs bug
|| ($cwd =~ m#^/tmp# and $mtime && $mtime==$ctime && $^O eq 'solaris')
|| $cwd =~ m#/afs/#
- || $^O eq 'amigaos') {
+ || $^O eq 'amigaos'
+ || $^O eq 'morphos') {
print "ok 4 # skipped: different semantic of mtime/ctime\n";
}
elsif ( ($mtime && $mtime != $ctime) ) {
@@ -141,7 +143,7 @@
unlink 'Op.stat.tmp2';
if (! -e 'Op.stat.tmp2') {print "ok 28\n";} else {print "not ok 28\n";}
-if ($Is_MSWin32 || $Is_Dos)
+if ($Is_MSWin32 || $Is_Dos || $Is_Amiga)
{print "ok 29\n";}
elsif ($DEV !~ /\nc.* (\S+)\n/)
{print "ok 29\n";}
@@ -171,7 +173,7 @@
{print "not ok 33\n";}
if (! -b '.') {print "ok 34\n";} else {print "not ok 34\n";}
-if ($^O eq 'mpeix' or $^O eq 'amigaos' or $Is_Dosish or $Is_Cygwin) {
+if ($^O eq 'mpeix' or $^O eq 'amigaos' or $^O eq 'morphos' or $Is_Dosish or $Is_Cygwin) {
print "ok 35 # skipped: no -u\n"; goto tty_test;
}
@@ -250,7 +252,7 @@
open(FOO,'op/stat.t');
eval { -T FOO; };
-if ($@ =~ /not implemented/) {
+if ($@ =~ /not implemented/ || $@ =~ /Cannot/) {
print "# $@";
for (45 .. 54) {
print "ok $_\n";
diff -ruN perl-5.6.1-orig/t/op/taint.t perl-5.6.1/t/op/taint.t
--- perl-5.6.1-orig/t/op/taint.t Fri Feb 23 02:57:58 2001
+++ perl-5.6.1/t/op/taint.t Thu Aug 12 21:28:43 2004
@@ -142,7 +142,7 @@
}
my $tmp;
- if ($^O eq 'os2' || $^O eq 'amigaos' || $Is_MSWin32 || $Is_Dos) {
+ if ($^O eq 'os2' || $^O eq 'amigaos' || $^O eq 'morphos' || $Is_MSWin32 || $Is_Dos) {
print "# all directories are writeable\n";
}
else {
@@ -397,7 +397,7 @@
{
my $foo = $TAINT;
- if ($^O eq 'amigaos') {
+ if ($^O eq 'amigaos' || $^O eq 'morphos') {
for (76..79) { print "ok $_ # Skipped: open('|') is not available\n" }
}
else {
diff -ruN perl-5.6.1-orig/utils/c2ph.PL perl-5.6.1/utils/c2ph.PL
--- perl-5.6.1-orig/utils/c2ph.PL Fri Feb 23 02:57:58 2001
+++ perl-5.6.1/utils/c2ph.PL Sun Aug 29 15:05:38 2004
@@ -1393,7 +1393,7 @@
unlink 'pstruct';
print "Linking c2ph to pstruct.\n";
if (defined $Config{d_link}) {
- link 'c2ph', 'pstruct';
+ symlink 'c2ph', 'pstruct';
} else {
unshift @INC, '../lib';
require File::Copy;
